home *** CD-ROM | disk | FTP | other *** search
- unit Thpr;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls;
-
- type
- TForm1 = class(TForm)
- ScrollBar1: TScrollBar;
- ScrollBar2: TScrollBar;
- ComboBox1: TComboBox;
- Button1: TButton;
- Button2: TButton;
- procedure Button1Click(Sender: TObject);
- procedure Button2Click(Sender: TObject);
- procedure ComboBox1Change(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
- var
- Form1: TForm1;
- thHandle1,
- thHandle2,
- ThIDOne,
- ThIDTwo: integer;
- thPriority : integer;
-
- implementation
-
- {$R *.DFM}
-
- procedure Delay(Num : LongInt);
- // waste some time
- var
- tc : LongInt;
- begin
- tc := GetTickCount;
- repeat
- until ((GetTickCount-tc)>=Num);
- end;
-
- function ScrollOne( P : Pointer ) : integer;
- begin
- repeat
- if Form1.ScrollBar1.Position = Form1.ScrollBar1.Max then
- Form1.ScrollBar1.Position := Form1.ScrollBar1.Min
- else Form1.ScrollBar1.Position := Form1.ScrollBar1.Position + 1;
- Delay(100);
- until 1 = 2;
- end;
-
- function ScrollTwo( P : Pointer ) : integer;
- begin
- repeat
- if Form1.ScrollBar2.Position = Form1.ScrollBar2.Max then
- Form1.ScrollBar2.Position := Form1.ScrollBar2.Min
- else Form1.ScrollBar2.Position := Form1.ScrollBar2.Position + 1;
- Delay(100);
- until 1 = 2;
- end;
-
- procedure TForm1.Button1Click(Sender: TObject);
- begin
- Button1.Enabled := False; // don't try recreating these Threads!
- ComboBox1.Enabled := False;
- try
- thHandle1 := BeginThread(nil,0,ScrollOne,nil,0,ThIDOne);
- thHandle2 := BeginThread(nil,0,ScrollTwo,nil,0,ThIDTwo);
- SetThreadPriority(thHandle1, thPriority);
- finally
- if thHandle1 <> 0 then
- CloseHandle(thHandle1);
- if thHandle2 <> 0 then
- CloseHandle(thHandle2);
- end;
- end;
-
- procedure TForm1.Button2Click(Sender: TObject);
- begin
- Close;
- end;
-
- procedure TForm1.ComboBox1Change(Sender: TObject);
- begin
- Case( ComboBox1.ItemIndex) of
- 0: thPriority := THREAD_PRIORITY_ABOVE_NORMAL ;
- 1: thPriority := THREAD_PRIORITY_BELOW_NORMAL ;
- 2: thPriority := THREAD_PRIORITY_HIGHEST ;
- 3: thPriority := THREAD_PRIORITY_IDLE ;
- 4: thPriority := THREAD_PRIORITY_NORMAL ;
- 5: thPriority := THREAD_PRIORITY_TIME_CRITICAL ;
- end;
- end;
-
- procedure TForm1.FormCreate(Sender: TObject);
- begin
- thPriority := THREAD_PRIORITY_NORMAL ;
- end;
-
- end.
-